COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 This needs Larry's attention
C00008 ENDMK
C⊗;
;;; This needs Larry's attention
(DECLARE (LOCALVARS . T)(GLOBALVARS ANSWER FINAL))

(RPAQ BOARD (ARRAY 15 15))
(RPAQ SEQUENCE (ARRAY 14 14)
(RPAQ A (ARRAY 36 36))
(RPAQ B (ARRAY 36 36))
(RPAQ C (ARRAY 36 36))

(DEFINEQ (INIT
	  (LAMBDA ()
		  (for I from 1 to 15 do (SETA BOARD I 1))
		  (SETA BOARD 5 0)
		  ((LAMBDA (G0016 G0017) 
			   (PROG (I L) 
				 (PROGN (SETQ I G0016) (SETQ L G0017))
				 LOOP (COND ((NULL L) (RETURN NIL)))
				 (SETA A I (CAR L))
				 ((LAMBDA (G0016 G0017) 
					  (PROGN (SETQ I G0016) (SETQ L G0017)))
				  (ADD1 I)
				  (CDR L))
				 (GO LOOP)))
		   1
		   '(1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4
		       4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6))
		  ((LAMBDA (G0016 G0017) 
			   (PROG (I L) 
				 (PROGN (SETQ I G0016) (SETQ L G0017))
				 LOOP (COND ((NULL L) (RETURN NIL)))
				 (SETA B I (CAR L))
				 ((LAMBDA (G0016 G0017) 
					  (PROGN (SETQ I G0016) (SETQ L G0017)))
				  (ADD1 I)
				  (CDR L))
				 (GO LOOP)))
		   1
		   '(2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5
		       2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5))
		  ((LAMBDA (G0016 G0017) 
			   (PROG (I L) 
				 (PROGN (SETQ I G0016) (SETQ L G0017))
				 LOOP (COND ((NULL L) (RETURN NIL)))
				 (SETA C I (CAR L))
				 ((LAMBDA (G0016 G0017) 
					  (PROGN (SETQ I G0016) (SETQ L G0017)))
				  (ADD1 I)
				  (CDR L))
				 (GO LOOP)))
		   1
		   '(4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6
		       1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4)))))

(DEFINEQ
  (LAST-POSITION
   (LAMBDA NIL 
	   (PROG (I) 
		 (SETQ I 1)
		 LOOP (COND ((IEQP I 16) (RETURN 0)))
		 (COND ((IEQP 1 (ELT BOARD I)) (RETURN I)))
		 (SETQ I (ADD1 I))
		 (GO LOOP)))))


(DEFINEQ
  (TRY
   (LAMBDA (I DEPTH) 
     (COND
      ((IEQP DEPTH 14)
       ((LAMBDA (LP) 
	  (COND ((MEMBER LP FINAL)) (T (RPAQ FINAL (CONS LP FINAL)))))
	(LAST-POSITION))
       (RPAQ ANSWER (CONS (CDR (LISTARRAY (QUOTE SEQUENCE))) ANSWER))
       T)
      ((AND (IEQP 1 (ELT BOARD (ELT A I)))
	    (IEQP 1 (ELT BOARD (ELT B I)))
	    (IEQP 0 (ELT BOARD (ELT C I))))
       (SETA BOARD (ELT A I) 0)
       (SETA BOARD (ELT B I) 0)
       (SETA BOARD (ELT C I) 1)
       (SETA SEQUENCE DEPTH I)
       ((LAMBDA (G0015) 
	  (PROG (J DEPTH) 
		(SETQ J 0)
		(SETQ DEPTH G0015)
	   LOOP	(COND ((OR (IEQP J 36) (TRY J DEPTH)) (RETURN NIL)))
		(SETQ J (ADD1 J))
		(GO LOOP)))
	(ADD1 DEPTH))
       (SETA BOARD (ELT A I) 1)
       (SETA BOARD (ELT B I) 1)
       (SETA BOARD (ELT C I) 0)
       NIL)))))


(DEFINEQ (LISTARRAY 
	  (LAMBDA (ARRAY N)
		  (for I from 1 to N collect (ELT ARRAY I)))))

(DEFINEQ
  (GOGOGO (LAMBDA (I) ((LAMBDA (ANSWER FINAL) (TRY I 1)) NIL NIL))))

(TIMER TIMIT 
	(GOGOGO 23))

(* THIS WILL TEST (ROUGHLY) THE ALGORITHM)

(DEFINEQ (TEST (LAMBDA NIL 
		  ((LAMBDA (ANSWER FINAL) 
		     (TRY 22 1)
		     (IEQP (LENGTH ANSWER) 775))
		   NIL
		   NIL))))